home *** CD-ROM | disk | FTP | other *** search
/ Sprite 1984 - 1993 / Sprite 1984 - 1993.iso / src / lib / tclX6.4c / dist / tests / filecmds.test < prev    next >
Encoding:
Text File  |  1992-11-07  |  2.6 KB  |  99 lines
  1. #
  2. # filecmds.test
  3. #
  4. # Tests for the copyfile, and pipe commands.
  5. #---------------------------------------------------------------------------
  6. # Copyright 1992 Karl Lehenbauer and Mark Diekhans.
  7. #
  8. # Permission to use, copy, modify, and distribute this software and its
  9. # documentation for any purpose and without fee is hereby granted, provided
  10. # that the above copyright notice appear in all copies.  Karl Lehenbauer and
  11. # Mark Diekhans make no representations about the suitability of this
  12. # software for any purpose.  It is provided "as is" without express or
  13. # implied warranty.
  14. #------------------------------------------------------------------------------
  15. # $Id: filecmds.test,v 2.0 1992/10/16 04:49:46 markd Rel $
  16. #------------------------------------------------------------------------------
  17. #
  18.  
  19. if {[info procs test] != "test"} then {source testlib.tcl}
  20.  
  21. # Create a test file
  22.  
  23. catch {unlink {IOTEST.TMP IOTEST2.TMP}}
  24.  
  25. set testFH [open IOTEST.TMP w]
  26. for {set cnt 0} {$cnt < 100} {incr cnt} {
  27.      puts $testFH [GenRec $cnt]
  28. }
  29. close $testFH
  30.  
  31. Test filecmds-3.1 {copyfile tests} {
  32.     set testFH [open IOTEST.TMP r]
  33.     set testFH2 [open IOTEST2.TMP w]
  34.     copyfile $testFH $testFH2
  35.     close $testFH
  36.     close $testFH2
  37.     system "diff IOTEST.TMP IOTEST2.TMP >/dev/null 2>&1"
  38. } 0 0
  39.  
  40. Test filecmds-3.2 {copyfile tests} {
  41.     set testFH [open IOTEST.TMP w]
  42.     set testFH2 [open IOTEST2.TMP w]
  43.     set stat [list [catch {copyfile $testFH $testFH2} msg] $msg]
  44.     close $testFH
  45.     close $testFH2
  46.     set stat
  47. } 0 {1 {Source file is not open for read access}}
  48.  
  49. Test filecmds-3.3 {copyfile tests} {
  50.     set testFH [open IOTEST.TMP r]
  51.     set testFH2 [open IOTEST2.TMP r]
  52.     copyfile $testFH $testFH2
  53. } 1 {Target file is not open for write access}
  54.  
  55. close $testFH
  56. close $testFH2
  57.  
  58. Test filecmds-3.4 {copyfile tests} {
  59.     copyfile $testFH $testFH2
  60. } 1 "file \"$testFH\" isn't open"
  61.  
  62. Test filecmds-3.5 {copyfile tests} {
  63.     copyfile
  64. } 1 {wrong # args: copyfile fromfilehandle tofilehandle}
  65.  
  66. pipe readPF writePF
  67.  
  68. flush stdout  ;# Not going to exec, must clean up the buffers.
  69. flush stderr
  70. set sonPid [fork]
  71.  
  72. if {$sonPid == 0} {
  73.     for {set cnt 0} {$cnt < 50} {incr cnt} {
  74.         Test filecmds-4.1 {pipe tests} {
  75.             if {![gets $readPF msgBuf]} {
  76.                set msgBuf "Premature eof on pipe"
  77.             }
  78.             set msgBuf
  79.         } 0 [GenRec $cnt]
  80.     }
  81.     close $readPF
  82.     exit 0
  83. }
  84.  
  85. for {set cnt 0} {$cnt < 50} {incr cnt} {
  86.     puts $writePF [GenRec $cnt]
  87. }
  88. flush $writePF
  89. Test filecmds-4.2 {pipe tests} {
  90.     wait $sonPid
  91. } 0 "$sonPid EXIT 0"
  92.  
  93. close $readPF
  94. close $writePF
  95.  
  96. unlink {IOTEST.TMP IOTEST2.TMP OUTPUT.TMP INCMDS.TMP}
  97.  
  98.  
  99.